home *** CD-ROM | disk | FTP | other *** search
/ Programming Languages Suite / ProgramD2.iso / Borland / Borland Pascal with Objects 7.0 / WINDEMOS.ZIP / FDLGDEMO.PAS < prev    next >
Pascal/Delphi Source File  |  1992-10-27  |  4KB  |  161 lines
  1. {************************************************}
  2. {                                                }
  3. {   Demo program                                 }
  4. {   Copyright (c) 1991 by Borland International  }
  5. {                                                }
  6. {************************************************}
  7.  
  8. { Demo of FILEDLGS unit }
  9.  
  10. program FDlgDemo;
  11.  
  12. {$S-}
  13. {$R FDLGDEMO.RES}
  14.  
  15. uses WinTypes, WinProcs, WinDos, Strings, FileDlgs;
  16.  
  17. const
  18.   AppName = 'FDlgDemo';
  19.  
  20. const
  21.   id_New    = 100;
  22.   id_Open   = 101;
  23.   id_Save   = 102;
  24.   id_SaveAs = 103;
  25.   id_Exit   = 199;
  26.   id_About  = 200;
  27.  
  28. const
  29.   GFileName: array[0..fsPathName] of Char = '';
  30.  
  31. function About(Dialog: HWnd; Message, WParam: Word;
  32.   LParam: Longint): Bool; export;
  33. begin
  34.   About := True;
  35.   case Message of
  36.     wm_InitDialog:
  37.       Exit;
  38.     wm_Command:
  39.       if (WParam = id_Ok) or (WParam = id_Cancel) then
  40.       begin
  41.         EndDialog(Dialog, 1);
  42.         Exit;
  43.       end;
  44.   end;
  45.   About := False;
  46. end;
  47.  
  48. function MainWndProc(Window: HWnd; Message, WParam: Word;
  49.   LParam: Longint): Longint; export;
  50. var
  51.   AboutProc: TFarProc;
  52.   DC: HDC;
  53.   PS: TPaintStruct;
  54.   P: PChar;
  55.   S: array[0..127] of Char;
  56. begin
  57.   MainWndProc := 0;
  58.   case Message of
  59.     wm_Command:
  60.       case WParam of
  61.         id_Open:
  62.           begin
  63.             DoFileOpen(Window, StrCopy(GFileName, '*.pas'));
  64.             InvalidateRect(Window, nil, True);
  65.             Exit;
  66.           end;
  67.         id_Save, id_SaveAs:
  68.           begin
  69.             DoFileSave(Window, GFileName);
  70.             InvalidateRect(Window, nil, True);
  71.             Exit;
  72.           end;
  73.         id_Exit:
  74.           begin
  75.             SendMessage(Window, wm_Close, 0, 0);
  76.             Exit;
  77.           end;
  78.         id_About:
  79.           begin
  80.             AboutProc := MakeProcInstance(@About, HInstance);
  81.             DialogBox(HInstance, 'AboutBox', Window, AboutProc);
  82.             FreeProcInstance(AboutProc);
  83.             Exit;
  84.           end;
  85.       end;
  86.     wm_Paint:
  87.       begin
  88.         DC := BeginPaint(Window, PS);
  89.         P := @GFileName;
  90.         TextOut(DC, 10, 10, S, WVSPrintF(S, 'File name:  %s', P));
  91.         EndPaint(Window, PS);
  92.       end;
  93.     wm_Destroy:
  94.       begin
  95.         PostQuitMessage(0);
  96.         Exit;
  97.       end;
  98.   end;
  99.   MainWndProc := DefWindowProc(Window, Message, WParam, LParam);
  100. end;
  101.  
  102. procedure InitApplication;
  103. const
  104.   WindowClass: TWndClass = (
  105.     style: 0;
  106.     lpfnWndProc: @MainWndProc;
  107.     cbClsExtra: 0;
  108.     cbWndExtra: 0;
  109.     hInstance: 0;
  110.     hIcon: 0;
  111.     hCursor: 0;
  112.     hbrBackground: 0;
  113.     lpszMenuName: AppName;
  114.     lpszClassName: AppName);
  115. begin
  116.   WindowClass.hInstance := HInstance;
  117.   WindowClass.hIcon := LoadIcon(0, idi_Application);
  118.   WindowClass.hCursor := LoadCursor(0, idc_Arrow);
  119.   WindowClass.hbrBackground := GetStockObject(white_Brush);
  120.   if not RegisterClass(WindowClass) then Halt(1);
  121. end;
  122.  
  123. procedure InitInstance;
  124. var
  125.   Window: HWnd;
  126. begin
  127.   Window := CreateWindow(
  128.     AppName,
  129.     'File Dialogs Demo',
  130.     ws_OverlappedWindow,
  131.     cw_UseDefault,
  132.     cw_UseDefault,
  133.     cw_UseDefault,
  134.     cw_UseDefault,
  135.     0,
  136.     0,
  137.     HInstance,
  138.     nil);
  139.   if Window = 0 then Halt(1);
  140.   ShowWindow(Window, CmdShow);
  141.   UpdateWindow(Window);
  142. end;
  143.  
  144. procedure WinMain;
  145. var
  146.   Message: TMsg;
  147. begin
  148.   if HPrevInst = 0 then InitApplication;
  149.   InitInstance;
  150.   while GetMessage(Message, 0, 0, 0) do
  151.   begin
  152.     TranslateMessage(Message);
  153.     DispatchMessage(Message);
  154.   end;
  155.   Halt(Message.wParam);
  156. end;
  157.  
  158. begin
  159.   WinMain;
  160. end.
  161.